home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / t / lib / soundex.t < prev   
Encoding:
Text File  |  1995-10-30  |  2.4 KB  |  146 lines  |  [TEXT/MPS ]
  1. #!./perl
  2. #
  3. # $Id: soundex.t,v 1.2 1994/03/24 00:30:27 mike Exp $
  4. #
  5. # test module for soundex.pl
  6. #
  7. # $Log: soundex.t,v $
  8. # Revision 1.2  1994/03/24  00:30:27  mike
  9. # Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu>
  10. # in the way I handles leasing characters which were different but had
  11. # the same soundex code.  This showed up comparing it with Oracle's
  12. # soundex output.
  13. #
  14. # Revision 1.1  1994/03/02  13:03:02  mike
  15. # Initial revision
  16. #
  17. #
  18.  
  19. BEGIN {
  20.     chdir 't' if -d 't';
  21.     chdir '::' unless -d 'lib';
  22. #    @INC = '../lib';
  23.     @INC = '::lib';
  24. }
  25.  
  26. use Text::Soundex;
  27.  
  28. $test = 0;
  29. print "1..13\n";
  30.  
  31. while (<DATA>)
  32. {
  33.   chop;
  34.   next if /^\s*;?#/;
  35.   next if /^\s*$/;
  36.  
  37.   ++$test;
  38.   $bad = 0;
  39.  
  40.   if (/^eval\s+/)
  41.   {
  42.     ($try = $_) =~ s/^eval\s+//;
  43.  
  44.     eval ($try);
  45.     if ($@)
  46.     {
  47.       $bad++;
  48.       print "not ok $test\n";
  49.       print "# eval '$try' returned $@";
  50.     }
  51.   }
  52.   elsif (/^\(/)
  53.   {
  54.     ($in, $out) = split (':');
  55.  
  56.     $try = "\@expect = $out; \@got = &soundex $in;";
  57.     eval ($try);
  58.  
  59.     if (@expect != @got)
  60.     {
  61.       $bad++;
  62.       print "not ok $test\n";
  63.       print "# expected ", scalar @expect, " results, got ", scalar @got, "\n";
  64.       print "# expected (", join (', ', @expect),
  65.         ") got (", join (', ', @got), ")\n";
  66.     }
  67.     else
  68.     {
  69.       while (@got)
  70.       {
  71.     $expect = shift @expect;
  72.     $got = shift @got;
  73.  
  74.     if ($expect ne $got)
  75.     {
  76.       $bad++;
  77.       print "not ok $test\n";
  78.       print "# expected $expect, got $got\n";
  79.     }
  80.       }
  81.     }
  82.   }
  83.   else
  84.   {
  85.     ($in, $out) = split (':');
  86.  
  87.     $try = "\$expect = $out; \$got = &soundex ($in);";
  88.     eval ($try);
  89.  
  90.     if ($expect ne $got)
  91.     {
  92.       $bad++;
  93.       print "not ok $test\n";
  94.       print "# expected $expect, got $got\n";
  95.     }
  96.   }
  97.  
  98.   print "ok $test\n" unless $bad;
  99. }
  100.  
  101. __END__
  102. #
  103. # 1..6
  104. #
  105. # Knuth's test cases, scalar in, scalar out
  106. #
  107. 'Euler':'E460'
  108. 'Gauss':'G200'
  109. 'Hilbert':'H416'
  110. 'Knuth':'K530'
  111. 'Lloyd':'L300'
  112. 'Lukasiewicz':'L222'
  113. #
  114. # 7..8
  115. #
  116. # check default bad code
  117. #
  118. '2 + 2 = 4':undef
  119. undef:undef
  120. #
  121. # 9
  122. #
  123. # check array in, array out
  124. #
  125. ('Ellery', 'Ghosh', 'Heilbronn', 'Kant', 'Ladd', 'Lissajous'):('E460', 'G200', 'H416', 'K530', 'L300', 'L222')
  126. #
  127. # 10
  128. #
  129. # check array with explicit undef
  130. #
  131. ('Mike', undef, 'Stok'):('M200', undef, 'S320')
  132. #
  133. # 11..12
  134. #
  135. # check setting $Text::Soundex::noCode
  136. #
  137. eval $soundex_nocode = 'Z000';
  138. ('Mike', undef, 'Stok'):('M200', 'Z000', 'S320')
  139. #
  140. # 13
  141. #
  142. # a subtle difference between me & oracle, spotted by Rich Pinder
  143. # <rpinder@hsc.usc.edu>
  144. #
  145. CZARKOWSKA:C622
  146.